suppressPackageStartupMessages({
library(readxl)
library(knitr)
library(pastecs)
library(ggplot2)
library(corrplot)
library(factoextra)
library(FactoMineR)
library(lattice)
library(rmarkdown)
library(ggrepel)
library(cluster)
library(heatmaply)
library(NbClust)
library(seriation)
})
#caragmos librerias
#Grupo de librerias 1
#library(readxl)#libreria para importar
#library(knitr)#libreria para las tablas
#Grupo de librerias 1
#library(pastecs)#para estadistico multivariantes
#library(ggplot2)
#library(corrplot)#para visualizar matrices de correlacion
#Grupo de librerias especificas para el modulo
#library(factoextra)
#library(FactoMineR)#para realizar analisis multivariante(mineria de datos)
#library(lattice)
#library(rmarkdown)
#library(ggrepel)
#library(cluster)
#library(heatmaply)#representar mapas de calor (para distancias)
#library(NbClust)#determinar numero optimo de cluster que se encuentra en nuestro conjunto de datos
#library(seriation)
El fichero Provincias.xlsx contiene informaciòn socio-econòmica de las provincias españolas.
Ejercicio 1 (0.5). Calcular la matriz de correlaciones, y su representación gráfica ¿Cuáles son las variables más correlacionadas de forma inversa?
getwd()
## [1] "C:/Users/Laura/Documents/GitHub/Modelizacion_in_R/PCA & Cluster"
Provincias <- read_excel("C:/Users/Laura/Dropbox/UCM/Mineria_y_modelizacion_2/Evaluacion/Provincias.xlsx" )
datos <- as.data.frame(Provincias)
#Estadisticos básicos de variables opción summary()
summary(datos)
## Prov Poblacion Mortalidad Natalidad
## Length:52 Min. : 84509 Min. : 5.820 Min. : 5.550
## Class :character 1st Qu.: 322203 1st Qu.: 7.855 1st Qu.: 7.700
## Mode :character Median : 614723 Median : 9.120 Median : 8.975
## Mean : 899449 Mean : 9.379 Mean : 8.839
## 3rd Qu.:1019030 3rd Qu.:10.688 3rd Qu.: 9.610
## Max. :6454440 Max. :14.360 Max. :19.330
## IPC NumEmpresas Industria Construccion
## Min. :100.6 Min. : 3749 Min. : 75 Min. : 309
## 1st Qu.:101.9 1st Qu.: 22822 1st Qu.: 1704 1st Qu.: 2972
## Median :102.3 Median : 38000 Median : 2516 Median : 5070
## Mean :102.4 Mean : 61286 Mean : 3808 Mean : 7805
## 3rd Qu.:102.7 3rd Qu.: 65083 3rd Qu.: 4106 3rd Qu.: 8350
## Max. :104.8 Max. :508612 Max. :27416 Max. :59661
## CTH Infor AFS APT
## Min. : 2030 Min. : 35.0 Min. : 50.0 Min. : 504
## 1st Qu.: 9243 1st Qu.: 185.5 1st Qu.: 486.8 1st Qu.: 3091
## Median : 15488 Median : 369.5 Median : 813.5 Median : 5440
## Mean : 23741 Mean : 1131.9 Mean : 1378.3 Mean : 10854
## 3rd Qu.: 27567 3rd Qu.: 868.2 3rd Qu.: 1429.2 3rd Qu.: 10627
## Max. :158331 Max. :19058.0 Max. :12357.0 Max. :123863
## TasaActividad TasaParo Ocupados PIB
## Min. :47.41 Min. :11.95 Min. : 24.6 Min. : 1397441
## 1st Qu.:55.45 1st Qu.:15.39 1st Qu.: 132.4 1st Qu.: 6509393
## Median :57.79 Median :19.51 Median : 222.4 Median : 11883640
## Mean :57.84 Mean :21.17 Mean : 347.1 Mean : 20275145
## 3rd Qu.:60.07 3rd Qu.:27.75 3rd Qu.: 389.8 3rd Qu.: 21242697
## Max. :68.69 Max. :37.18 Max. :2806.4 Max. :198652445
## CANE TVF VS
## Min. : 3 Min. : 26233 Min. : 200
## 1st Qu.: 9758 1st Qu.: 211628 1st Qu.: 38941
## Median :14037 Median : 335934 Median : 56412
## Mean :19035 Mean : 484781 Mean : 70799
## 3rd Qu.:26020 3rd Qu.: 532066 3rd Qu.: 80625
## Max. :68037 Max. :2894679 Max. :326705
rownames(datos)<-datos[,1]
datos_n<-datos[,-c(1)]
Una vez hemos sacado lo datos de tipo categóricos, saquemos la matriz de correlaciones, y veamos su representación gŕafica
R <- cor(datos_n, method="pearson")#metodo pearson para encontrar las correlaciones entre variable
matriz_cor <- as.data.frame(R)
corrplot(R,type="upper", order = "hclust",tl.col = "black", tl.cex = 0.6,tl.srt = 90)
#tl.col <- color de las etiquetas
#tl.cex <- tamaño de letra
#tl.srt <- espaciado entre etieutas y recuadros entre si.
#Ordenación de las hojas en un diagrama hclust
# tipo de cuadricula superior
#metodo <- mide que tan corellacionadas estan las variables por el método de pearson
Notemos que:
Si en una provincia hay mayor cantidad de defunciones entonces hay un menor Tasa de actividad. A medida que aumenta la mortalidad, disminuye la Tasa de Actividad, lo que significa que tienen una correlación de tipo inversa. Así mismo sucede con las variables Mortalidad y Natalidad.
El grupo de varaibles asociados a la industria junto con la Tasa de ocupados, los censos y el PIB, marcan una relación altamente positiva.
El CANE , Censo agrario no aporta mucho en relación con las demas variables, aunq ue faltaría estudiar el caso con el censo 2011 de viviendas secundarias.
A continuación presentamos los gŕaficos, asociados a los comportamientos de las variables.
xyplot(TasaActividad ~ Mortalidad, data =datos, main="Tasa de Actividad y Mortalidad ", type=c("p","r"),pch=19)
xyplot(Natalidad ~ Mortalidad, data =datos, main="Natalidad y Mortalidad ", type=c("p","r"),pch=19, col='red')
Ejercicio 2 (0.5). Realizar un análisis de componentes principales sobre la matriz de correlaciones, calculando 7 componentes. Estudiar los valores de los autovalores obtenidos y las gráficas que los resumen. ¿Cuál es el número adecuado de componentes?
#calcular el analisis de componentes ´principales
fit7 <- PCA(datos_n,scale.unit = TRUE,ncp = 7,graph = FALSE)
#graph tambien puede ser TTRUE en el caso en el que quiera mostrar los graficos correspondientes
#datos_n <- contiene todas las variables numéricas
#Variable estandar es aquella a la que se le ha restado la media y se ha dividio por su desviación tipica
#scale.unit = TRUE <- hallas los autovalores de la matriz de correlaciones. Es decir la matriz a diagonalizar es la matriz de correlaciones entre las variables.
#ncp: numero de componentes a retener en el resultado final
Veamos los autovalores de la matriz de correlaciones, y realicemos el análisis de las varianzas.
#Autovalores de la matriz R
eig<-get_eigenvalue(fit7)
knitr::kable(eig, digits =2,caption = "Autovalores")
| eigenvalue | variance.percent | cumulative.variance.percent | |
|---|---|---|---|
| Dim.1 | 11.47 | 63.70 | 63.70 |
| Dim.2 | 2.56 | 14.23 | 77.93 |
| Dim.3 | 1.63 | 9.08 | 87.01 |
| Dim.4 | 0.93 | 5.19 | 92.19 |
| Dim.5 | 0.46 | 2.54 | 94.73 |
| Dim.6 | 0.41 | 2.30 | 97.03 |
| Dim.7 | 0.31 | 1.71 | 98.74 |
| Dim.8 | 0.12 | 0.65 | 99.39 |
| Dim.9 | 0.07 | 0.41 | 99.79 |
| Dim.10 | 0.02 | 0.11 | 99.91 |
| Dim.11 | 0.01 | 0.05 | 99.96 |
| Dim.12 | 0.00 | 0.02 | 99.98 |
| Dim.13 | 0.00 | 0.01 | 99.99 |
| Dim.14 | 0.00 | 0.00 | 99.99 |
| Dim.15 | 0.00 | 0.00 | 100.00 |
| Dim.16 | 0.00 | 0.00 | 100.00 |
| Dim.17 | 0.00 | 0.00 | 100.00 |
| Dim.18 | 0.00 | 0.00 | 100.00 |
#Porcentaje de variabilidad acumulada
fviz_eig(fit7,addlabels=TRUE)
Sabemos que con la matriz de correlación de allí tomaremos los autovalores que contribuyen en el porcentaje de varianza acumulada para elegir las componentes principales que son la combinación lineal de los autovectores generados por dichos autovalores. Para este ejercicio estipula 7 componentes principales, pero bajo el análisis pueden ser 3 o 4, pues estaría explicada la variabilidad aproximadamente en un 90%.
Ejercicio 3. Hacer de nuevo el análisis sobre la matriz de correlaciones pero ahora indicando el número de componentes principales que hemos decidido retener(Que expliquen eproximadamente el 90%). Sobre este análisis contestar los siguientes apartados.
fit3 <- PCA(datos_n,scale.unit = TRUE,ncp = 3,graph = FALSE)
a. (1) Mostrar los coeficientes para obtener las componentes principales. ¿ Cuál es la expresión para calcular la primera Componente en función de las variables originales?
#coeficientes de las componentes principales
knitr::kable(fit3$svd$V,digits =3,caption = "Autovectores")
| 0.294 | 0.002 | 0.050 |
| -0.106 | -0.527 | 0.189 |
| 0.041 | 0.495 | -0.271 |
| 0.110 | -0.365 | -0.262 |
| 0.294 | -0.026 | 0.008 |
| 0.286 | -0.045 | 0.046 |
| 0.293 | -0.045 | -0.012 |
| 0.293 | -0.011 | 0.049 |
| 0.282 | -0.042 | -0.065 |
| 0.292 | -0.016 | 0.040 |
| 0.291 | -0.029 | -0.028 |
| 0.114 | 0.331 | -0.363 |
| -0.014 | 0.462 | 0.387 |
| 0.294 | -0.017 | 0.002 |
| 0.291 | -0.036 | -0.037 |
| 0.018 | 0.096 | 0.657 |
| 0.292 | -0.002 | 0.100 |
| 0.172 | 0.048 | 0.290 |
Las componentes estarian determinadas de la siguiente manera,
b. (0.5) Mostar una tabla con las correlaciones de las Variables con las Componentes Principales. Para cada Componente indicar las variables con las que está más correlacionada
var<-get_pca_var(fit3)
knitr::kable(var$cor, digits =2, caption = "Correlaciones de la CP con las variables")
| Dim.1 | Dim.2 | Dim.3 | |
|---|---|---|---|
| Poblacion | 0.99 | 0.00 | 0.06 |
| Mortalidad | -0.36 | -0.84 | 0.24 |
| Natalidad | 0.14 | 0.79 | -0.35 |
| IPC | 0.37 | -0.58 | -0.34 |
| NumEmpresas | 1.00 | -0.04 | 0.01 |
| Industria | 0.97 | -0.07 | 0.06 |
| Construccion | 0.99 | -0.07 | -0.02 |
| CTH | 0.99 | -0.02 | 0.06 |
| Infor | 0.95 | -0.07 | -0.08 |
| AFS | 0.99 | -0.03 | 0.05 |
| APT | 0.98 | -0.05 | -0.04 |
| TasaActividad | 0.39 | 0.53 | -0.46 |
| TasaParo | -0.05 | 0.74 | 0.50 |
| Ocupados | 1.00 | -0.03 | 0.00 |
| PIB | 0.99 | -0.06 | -0.05 |
| CANE | 0.06 | 0.15 | 0.84 |
| TVF | 0.99 | 0.00 | 0.13 |
| VS | 0.58 | 0.08 | 0.37 |
c. (1) Comentar los gráficos que representan las variables en los planos formados por las componentes, intentando explicar lo que representa cada componente.
#Representación gráfica de las variables
fviz_pca_var(fit3, axes = c(1, 2), col.var="cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)
## Warning: ggrepel: 11 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
Notemos que:
fviz_pca_var(fit3, axes = c(2,3), col.var="cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)
## Warning: ggrepel: 9 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
Notemos que:
La variable CANE tiene una correlación alta con la componente 2. Se destaca que la variable Ocupados no esta correlacionada con la Componente 3.
Basandonos en este estudio podemos decir que en relación con la Componente 1 y las varaibles, estas tienen una correlación muy alta,y nos podría explicar muy bien los datos.
d. (0.25) Mostrar la tabla y los gráficos que nos muestran la proporción de la varianza de cada variable que es explicado por cada componente. ¿Cuál de las variables es la que está peor explicada?
knitr::kable(var$cos2, digits =2,caption = "Cosenos al cuadrado(variabilidad de cada variable explicado por cada componente)")
| Dim.1 | Dim.2 | Dim.3 | |
|---|---|---|---|
| Poblacion | 0.99 | 0.00 | 0.00 |
| Mortalidad | 0.13 | 0.71 | 0.06 |
| Natalidad | 0.02 | 0.63 | 0.12 |
| IPC | 0.14 | 0.34 | 0.11 |
| NumEmpresas | 0.99 | 0.00 | 0.00 |
| Industria | 0.94 | 0.01 | 0.00 |
| Construccion | 0.99 | 0.01 | 0.00 |
| CTH | 0.98 | 0.00 | 0.00 |
| Infor | 0.91 | 0.00 | 0.01 |
| AFS | 0.98 | 0.00 | 0.00 |
| APT | 0.97 | 0.00 | 0.00 |
| TasaActividad | 0.15 | 0.28 | 0.22 |
| TasaParo | 0.00 | 0.55 | 0.25 |
| Ocupados | 0.99 | 0.00 | 0.00 |
| PIB | 0.97 | 0.00 | 0.00 |
| CANE | 0.00 | 0.02 | 0.70 |
| TVF | 0.97 | 0.00 | 0.02 |
| VS | 0.34 | 0.01 | 0.14 |
# Representación gráfica de los cosenos
corrplot(var$cos2,is.corr=FALSE,tl.cex=0.6,tl.col = "black", cl.ratio=1)
fviz_cos2(fit3,choice="var",axes=1:3, tl.cex=0.6 )
Notemos que en el gráfico anterior se evidencia que VS(Viviendas secundarias) es la variable peor explicada respecto a las componentes.
e. (0.25) Mostrar la tabla y los gráficos que nos muestran el porcentaje de la varianza de cada Componente que es debido a cada variable. ¿Que variables contribuyen más a cada Componente?
knitr::kable(var$contrib,digits =2, caption = "Contribuciones")
| Dim.1 | Dim.2 | Dim.3 | |
|---|---|---|---|
| Poblacion | 8.62 | 0.00 | 0.25 |
| Mortalidad | 1.13 | 27.79 | 3.57 |
| Natalidad | 0.17 | 24.54 | 7.33 |
| IPC | 1.21 | 13.35 | 6.88 |
| NumEmpresas | 8.65 | 0.07 | 0.01 |
| Industria | 8.16 | 0.20 | 0.22 |
| Construccion | 8.60 | 0.21 | 0.01 |
| CTH | 8.58 | 0.01 | 0.24 |
| Infor | 7.92 | 0.18 | 0.42 |
| AFS | 8.55 | 0.03 | 0.16 |
| APT | 8.45 | 0.09 | 0.08 |
| TasaActividad | 1.31 | 10.93 | 13.16 |
| TasaParo | 0.02 | 21.30 | 15.00 |
| Ocupados | 8.67 | 0.03 | 0.00 |
| PIB | 8.46 | 0.13 | 0.14 |
| CANE | 0.03 | 0.93 | 43.13 |
| TVF | 8.50 | 0.00 | 1.00 |
| VS | 2.97 | 0.23 | 8.42 |
corrplot(var$contrib,is.corr=FALSE,tl.cex=0.6,tl.col = "black", cl.ratio=1 )
Contribucióń de las variables a las componentes.
fviz_contrib(fit3,choice="var",axes=1, tl.cex=0.6)
fviz_contrib(fit3,choice="var",axes=2, tl.cex=0.6)
fviz_contrib(fit3,choice="var",axes=3, tl.cex=0.6)
Notemos que:
f. (1) Sobre los gráficos que representan las observaciones en los nuevos ejes y el gráfico Biplot,teniendo en cuenta la posición de las provincias en el gráfico. Comentar las provincias que tienen una posición más destacada en cada componente, en positivo o negativo, ¿Qué significa esto en términos socioeconómicos para estas provincias?
fviz_pca_ind(fit3,axes = c(1, 2), col.ind = "cos2",col.cex=0.2, gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE)
## Warning: ggrepel: 24 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
Para valores representativos del gŕafico anterior,
Se observa que la \[CP_1\] Madrid y Barcelona tienen un valor alto por lo que tienen una buena cantidad de Ocupados, de NUmEmpresas, de Poblacion y tienen un numero alto de todo tipo de Industrias, y de Construcción, mientras que Albacete , Soria, Palencia tienen valores negativos en dicha componente lo que indica que bajo numero de Ocupados y de Industria, etc.
En la \[CP_2\], Melilla, Ceuta, Almería y Palmas presentan unos valores altos por lo que indica que tienen una Tasa alta de Mortalidad, Natalidad, Tasa de Paro, pero también hay un alto índice de inflación, mientras que Zamora, Lugo, Ourense, tienen valores negativos lo que indica bajas Tasas de Mortalidad , de natalidad, y hay un porcentaje mínimo de inflación.
fviz_pca_ind(fit3,axes = c(2, 3), col.ind = "cos2",col.cex=0.2, gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),repel = TRUE)
## Warning: ggrepel: 2 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
Para valores representativos del gŕafico anterior,
fviz_pca_biplot(fit3, repel = TRUE, col.var = "#2E9FDF", col.cex=0.2,col.ind = "#696969")
## Warning: ggrepel: 25 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
## Warning: ggrepel: 11 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
fviz_pca_biplot(fit3, repel = TRUE,axes = c(2,3), col.cex=0.2, col.var= "#2E9FDF", col.ind = "#696969")
## Warning: ggrepel: 2 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
## Warning: ggrepel: 8 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
g. (1) Si tuviéramos que construir un índice que valore de forma conjunta el desarrollo económico de una provincia, como se podría construir utilizando una combinación lineal de todas las variables. ¿Cuál sería el valor de dicho índice en Madrid? ¿Cual sería su valor en Melilla?
ind<-get_pca_ind(fit3)
knitr::kable(ind$coord,digits =3,caption = "Valores de las provincias en las Componentes")
| Dim.1 | Dim.2 | Dim.3 | |
|---|---|---|---|
| Albacete | -1.410 | 0.473 | 0.096 |
| Alicante | 3.384 | 0.540 | 1.919 |
| Almería | -0.617 | 2.614 | 0.208 |
| Álava | -1.444 | -0.001 | -2.032 |
| Asturias | -0.204 | -1.953 | 1.298 |
| Badajoz | -1.048 | 1.168 | 1.796 |
| Balears | 1.526 | 0.260 | -2.519 |
| Barcelona | 13.683 | -1.612 | -0.867 |
| Bizkaia | 0.576 | -1.508 | -1.180 |
| Burgos | -1.202 | -1.550 | -0.892 |
| Cantabria | -0.849 | -1.126 | -0.594 |
| Castellón | -0.690 | 0.821 | 0.518 |
| Ceuta | -2.125 | 3.326 | -1.811 |
| Ciudad Real | -1.392 | 0.815 | 1.819 |
| Coruña | 0.635 | -1.442 | 0.759 |
| Cuenca | -2.132 | -0.569 | 1.048 |
| Cáceres | -1.503 | -0.180 | 1.269 |
| Cádiz | 0.128 | 1.771 | 0.369 |
| Córdoba | -0.594 | 0.811 | 1.292 |
| Gipuzkoa | -0.281 | -1.485 | -1.879 |
| Girona | 0.388 | 0.544 | -1.387 |
| Granada | -0.072 | 1.124 | 1.511 |
| Guadalajara | -1.408 | 1.542 | -1.849 |
| Huelva | -1.265 | 1.168 | 0.013 |
| Huesca | -1.776 | -0.984 | -0.587 |
| Jaén | -1.221 | 1.424 | 3.407 |
| León | -1.464 | -2.016 | 0.877 |
| Lleida | -0.835 | -0.136 | -1.472 |
| Lugo | -1.826 | -2.785 | 0.871 |
| Madrid | 16.778 | -0.366 | -0.849 |
| Melilla | -2.218 | 4.782 | -1.905 |
| Murcia | 1.522 | 1.442 | 0.580 |
| Málaga | 2.006 | 1.325 | 0.869 |
| Navarra | -0.653 | 0.078 | -1.096 |
| Ourense | -1.965 | -2.858 | 1.098 |
| Palencia | -2.122 | -1.951 | -0.695 |
| Palmas | 0.092 | 1.857 | -0.330 |
| Pontevedra | 0.036 | -0.607 | 0.052 |
| Rioja | -1.383 | -0.484 | -1.354 |
| Salamanca | -1.612 | -1.425 | -0.121 |
| Santa Cruz | -0.029 | 1.573 | -0.126 |
| Segovia | -1.931 | -1.015 | -1.110 |
| Sevilla | 1.948 | 1.775 | 0.712 |
| Soria | -2.399 | -1.857 | -0.778 |
| Tarragona | 0.175 | 1.040 | -0.102 |
| Teruel | -2.185 | -1.082 | -0.351 |
| Toledo | -0.461 | 1.449 | 0.812 |
| Valencia | 4.770 | 0.360 | 2.961 |
| Valladolid | -1.007 | -0.704 | -1.052 |
| Zamora | -2.287 | -3.169 | 0.578 |
| Zaragoza | 0.115 | -0.237 | -0.156 |
| Ávila | -2.152 | -0.982 | 0.365 |
\[ 16.778 \alpha -0.366\beta -0.849\gamma\] para \[\alpha,\beta,\gamma =1 \] el Índice económico de Madrid es \[5.18\]. \[-2.218\alpha +4.782\beta -1.905\gamma\] para \[\alpha,\beta,\gamma =1 \] el índice económico de Melilla es \[0.21\]
Ejercicio 4. (0.5) Representar un mapa de calor de la matriz de datos, estandarizado y sin estandarizar para ver si se detectan inicialmente grupos de provincias.
Primero vamos a crear un conjunto de datos con las variables numéricas estandarizadas
data_ST<-scale(datos_n)
Veamos el mapa de calor para los datos estandarizados,
heatmaply(data_ST, seriate = "mean",row_dend_left = TRUE, plot_method = "plotly")
heatmaply(datos_n, seriate = "mean",row_dend_left = TRUE, plot_method = "plotly")
Ejercicio 5. Realizar un análisis Jerárquico de clusters para determinar si existen grupos de provincias con comportamiento similar.
Primero calcularemos las distancias con los valores sin estandarizar y mostremos las 6 primeras filas .
#Con valores sin estandarizar
d <- dist(datos_n, method = "euclidean")
d6 <- as.matrix(d)[1:6,1:6]
knitr::kable(d6,digits = 2, caption = "Distancias")
| Albacete | Alicante | Almería | Álava | Asturias | Badajoz | |
|---|---|---|---|---|---|---|
| Albacete | 0 | 24971242 | 4687257 | 3481471.5 | 14555211 | 3362039.7 |
| Alicante | 24971242 | 0 | 20284171 | 21510859.3 | 10424490 | 21610942.1 |
| Almería | 4687257 | 20284171 | 0 | 1277176.4 | 9869791 | 1328833.4 |
| Álava | 3481472 | 21510859 | 1277176 | 0.0 | 11088936 | 452219.3 |
| Asturias | 14555211 | 10424490 | 9869791 | 11088935.7 | 0 | 11197887.0 |
| Badajoz | 3362040 | 21610942 | 1328833 | 452219.3 | 11197887 | 0.0 |
Ahora, calculamos las distancias cpn los valores estandarizados.
d_st <- dist(data_ST, method = "euclidean") # distance matrix
d_st6<-as.matrix(d_st)[1:6, 1:6]
knitr::kable(d_st6, digits =2,caption = "Distancias")
| Albacete | Alicante | Almería | Álava | Asturias | Badajoz | |
|---|---|---|---|---|---|---|
| Albacete | 0.00 | 6.60 | 2.37 | 2.45 | 3.11 | 1.92 |
| Alicante | 6.60 | 0.00 | 6.07 | 7.35 | 5.90 | 6.35 |
| Almería | 2.37 | 6.07 | 0.00 | 3.68 | 4.77 | 2.39 |
| Álava | 2.45 | 7.35 | 3.68 | 0.00 | 4.20 | 4.22 |
| Asturias | 3.11 | 5.90 | 4.77 | 4.20 | 0.00 | 3.37 |
| Badajoz | 1.92 | 6.35 | 2.39 | 4.22 | 3.37 | 0.00 |
Ahora veamos gŕaficamente la matriz de distancias, con los datos sin estandarizar
fviz_dist(d, show_labels = TRUE)
Con los datos estandarizados,
fviz_dist(d_st, show_labels = TRUE)
a. (0.5) A la vista del dendograma ¿Cuantos clusters recomendarías?.
En ese orden, agrupamos las observaciones según el criterio de ward, y dibujamos el Dendograma correspondiente.
Criterio Ward: Método de Ward o de la mínima varianza, este método, entre todas las uniones de cluster posibles en cada nivel, selecciona aquella unión que minimiza la variabilidad interna de los cluster resultantes.
#método para medir distancias entre clusteres
#para datos sin estandarizar
res.hc <- hclust(d, method="ward.D2")
fviz_dend(res.hc, cex = 0.5)
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
Realizamos el cluster jerárquico con las distancias entre los datos estandarizados.
res.hc_st <- hclust(d_st, method="ward.D2")
fviz_dend(res.hc_st, cex = 0.5)
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
A la vista recomendaria K=5 clusters.
b. (0.5) Representar los individuos agrupados según el número de clusters elegido.
grp <- cutree(res.hc_st, k = 5)
knitr::kable(table(grp), caption = "Número de provincias por cluster")
| grp | Freq |
|---|---|
| 1 | 17 |
| 2 | 2 |
| 3 | 17 |
| 4 | 14 |
| 5 | 2 |
# Podemos ver las provincias del cluster 1-2-3-4-5
rownames(data_ST)[grp == 1]
## [1] "Albacete" "Asturias" "Coruña" "Cuenca" "Cáceres"
## [6] "Huesca" "León" "Lugo" "Ourense" "Palencia"
## [11] "Pontevedra" "Salamanca" "Segovia" "Soria" "Teruel"
## [16] "Zamora" "Ávila"
rownames(data_ST)[grp == 2]
## [1] "Alicante" "Valencia"
rownames(data_ST)[grp == 3]
## [1] "Almería" "Badajoz" "Castellón" "Ceuta" "Ciudad Real"
## [6] "Cádiz" "Córdoba" "Granada" "Huelva" "Jaén"
## [11] "Melilla" "Murcia" "Málaga" "Palmas" "Santa Cruz"
## [16] "Sevilla" "Toledo"
rownames(data_ST)[grp == 4]
## [1] "Álava" "Balears" "Bizkaia" "Burgos" "Cantabria"
## [6] "Gipuzkoa" "Girona" "Guadalajara" "Lleida" "Navarra"
## [11] "Rioja" "Tarragona" "Valladolid" "Zaragoza"
rownames(data_ST)[grp == 5]
## [1] "Barcelona" "Madrid"
fviz_dend(res.hc_st, k = 3, # Cut in four groups
cex = 0.5, # label size
color_labels_by_k = TRUE, # color labels by groups
rect = TRUE) # Add rectangle around groups
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
Visualizamos los clusters
#datos_ST <- matriz de datos estandatrizados
fviz_cluster(list(data = data_ST, cluster = grp), ellipse.type = "convex", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = FALSE, ggtheme = theme_minimal())
## Warning: ggrepel: 24 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
#d_st <- matriz de distancias estandarizadas
fviz_cluster(list(data = data_ST, cluster = grp),axes=c(3,4), ellipse.type = "convex", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = FALSE, ggtheme = theme_minimal())
## Warning: ggrepel: 6 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
c. (0.5) ¿Qué número óptimo de clusters nos indican los criterios Silhoutte y de Elbow?
Determinción del número óptimo de clusters por le método Elbow
fviz_nbclust(data_ST, kmeans, method = "wss") +
geom_vline(xintercept =3, linetype = 2)+
labs(subtitle = "Elbow method")
Silhouette method,
fviz_nbclust(data_ST, kmeans, method = "silhouette")+
labs(subtitle = "Silhouette method")
Por el método Ebow decidimos tomar \[k=3\] clusters
d. Con el número de clústeres que nos indica Elbow en el apartado anterior, realizar un agrupamiento no jerárquico.
i. (0.5) Representar los clústeres formados en los planos de las Componentes principales. Relacionar la posición de cada clúster en el plano con lo que representa cada componente principal.
Vamos a realizar un análisis no jerárquico para \[k=3\] clústeres. Fijemos la semilla.
RNGkind(sample.kind = "Rejection")
set.seed(1234)
km.res3 <- kmeans(data_ST, 3)
fviz_cluster(km.res3, data_ST)
fviz_cluster(km.res3, data_ST,axes=c(3,4), ellipse.type = "convex", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = FALSE, ggtheme = theme_minimal())
## Warning: ggrepel: 6 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
ii. (0.5) Evaluación de la calidad de los clústeres,
sil <- silhouette(km.res3$cluster, dist(data_ST))
rownames(sil) <- rownames(datos)
head(sil[, 1:3])
## cluster neighbor sil_width
## Albacete 2 1 0.23404690
## Alicante 1 2 0.12861643
## Almería 1 2 0.23985301
## Álava 2 1 0.33700472
## Asturias 2 1 0.38504449
## Badajoz 1 2 0.03338686
fviz_silhouette(sil)
## cluster size ave.sil.width
## 1 1 23 0.08
## 2 2 27 0.41
## 3 3 2 0.66
e. (1)Explicar las provincias que forman cada uno de los clústeres y comentar cuales son las características socioeconómicas que las hacen pertenecer a dicho clúster.
Primero veamos los grupo de provincias que forman cada uno de los clústres.
ordenado<-sort(km.res3$cluster)
knitr::kable(ordenado, digits =2, caption = "Provincia y cluster")
| x | |
|---|---|
| Alicante | 1 |
| Almería | 1 |
| Badajoz | 1 |
| Balears | 1 |
| Castellón | 1 |
| Ceuta | 1 |
| Ciudad Real | 1 |
| Cádiz | 1 |
| Córdoba | 1 |
| Girona | 1 |
| Granada | 1 |
| Guadalajara | 1 |
| Huelva | 1 |
| Jaén | 1 |
| Melilla | 1 |
| Murcia | 1 |
| Málaga | 1 |
| Palmas | 1 |
| Santa Cruz | 1 |
| Sevilla | 1 |
| Tarragona | 1 |
| Toledo | 1 |
| Valencia | 1 |
| Albacete | 2 |
| Álava | 2 |
| Asturias | 2 |
| Bizkaia | 2 |
| Burgos | 2 |
| Cantabria | 2 |
| Coruña | 2 |
| Cuenca | 2 |
| Cáceres | 2 |
| Gipuzkoa | 2 |
| Huesca | 2 |
| León | 2 |
| Lleida | 2 |
| Lugo | 2 |
| Navarra | 2 |
| Ourense | 2 |
| Palencia | 2 |
| Pontevedra | 2 |
| Rioja | 2 |
| Salamanca | 2 |
| Segovia | 2 |
| Soria | 2 |
| Teruel | 2 |
| Valladolid | 2 |
| Zamora | 2 |
| Zaragoza | 2 |
| Ávila | 2 |
| Barcelona | 3 |
| Madrid | 3 |
Veamos las características socioeconómicas de cada provincia, para ver que lo hace pertenecer a dicho clúster.
datos_n$grupo<- as.factor(km.res3$cluster)
ggplot(datos_n, aes(x=grupo, y=Poblacion, fill=grupo)) + geom_boxplot()
g1<- ggplot(datos_n, aes(x=grupo, y=Mortalidad, fill=grupo)) + geom_boxplot()
g2<- ggplot(datos_n, aes(x=grupo, y=Natalidad, fill=grupo)) + geom_boxplot()
g3<- ggplot(datos_n, aes(x=grupo, y=IPC, fill=grupo)) + geom_boxplot()
g4<- ggplot(datos_n, aes(x=grupo, y=NumEmpresas, fill=grupo)) + geom_boxplot()
g5<- ggplot(datos_n, aes(x=grupo, y=Industria, fill=grupo)) + geom_boxplot()
g6<- ggplot(datos_n, aes(x=grupo, y=Construccion, fill=grupo)) + geom_boxplot()
g7<- ggplot(datos_n, aes(x=grupo, y=CTH, fill=grupo)) + geom_boxplot()
g8<- ggplot(datos_n, aes(x=grupo, y=Infor, fill=grupo)) + geom_boxplot()
gridExtra::grid.arrange(g1, g2, g3, g4, g5, g6, g7, g8, ncol=2, nrow=4)
g9<- ggplot(datos_n, aes(x=grupo, y=AFS, fill=grupo)) + geom_boxplot()
g10<- ggplot(datos_n, aes(x=grupo, y=APT, fill=grupo)) + geom_boxplot()
g11<- ggplot(datos_n, aes(x=grupo, y=TasaActividad, fill=grupo)) + geom_boxplot()
g12<- ggplot(datos_n, aes(x=grupo, y=TasaParo, fill=grupo)) + geom_boxplot()
g13<- ggplot(datos_n, aes(x=grupo, y=Ocupados, fill=grupo)) + geom_boxplot()
g14<- ggplot(datos_n, aes(x=grupo, y=PIB, fill=grupo)) + geom_boxplot()
g15<- ggplot(datos_n, aes(x=grupo, y=CANE, fill=grupo)) + geom_boxplot()
g16<- ggplot(datos_n, aes(x=grupo, y=TVF, fill=grupo)) + geom_boxplot()
g17<- ggplot(datos_n, aes(x=grupo, y=VS, fill=grupo)) + geom_boxplot()
gridExtra::grid.arrange(g9, g10, g11, g12, g13, g14, g15, g16,g17 ,ncol=2, nrow=5)
Como lo creimos anterioremente, Madrid y Barcelona tienen caracteristicas asociadas al crecimiento industrial, al tipo de empresas en los sectores productivos, aunque no tiene altas tasas de Natalidad y Mortalidad.
Por el contrario el grupo 2, muestra bajos inidices de crecimiento empresarial, pero si presenta altas tasas de mortalidad, inclusive una tasa de actividad Media. Así mismo, tampoco cuenta con un gran número de empresas , posiblemente, por que cuenta con una población muy baja.
En el grupo 1 de provincias, podemos ver que, tampoco tiene un muy alto indice de crecimiento industrial, pero presenta índice de inflación mas bajo respecto a los otros grupos.